perm filename OC.FOX[MF,ALS] blob
sn#767288 filedate 1984-08-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 width reporting from GFTYPE
C00023 00003
C00035 00004 @ @<Glob...@>=
C00037 00005 Bask char 97: 3≤x<44 -1≤y<44
C00040 ENDMK
C⊗;
width reporting from GFTYPE
@ @<Process the character locations...@>=
repeat k←get_byte;
if k=char_loc then
begin c←first_par(char_loc);
v←signed_quad; w←signed_quad; p←signed_quad;
if wants_mnemonics then
begin print('Character ',c:1,': device width ',v:1,', width ',w:1,' (');
print_scaled(w div 16);
print_ln('ds), location ',p:1);
end;
if p≠char_ptr[c] then
error('character location should be ',char_ptr[c]:1,'!');
@.character location should be...@>
k←nop;
end;
until k≠nop;
@ @<Process the character locations...@>=
repeat k←get_byte;
if k=char_loc then begin
c←first_par(k);
if c>max_glyph_no then abort('Character number too large');
device_width[c]←signed_quad;
tfm_width[c]←signed_quad;
p←signed_quad;
k←nop;
end;
until k≠nop;
c←bs;
while c≤ec do
if glyph_ptr[c]≠-1 then
begin
oc_word(new_width(x_char_width[c]));
oc_word(new_width(y_char_width[c]));
oc_halfword(min_x_array[c];
oc_halfword(min_y_array[c];
oc_halfword(glyph_cols[c];
oc_halfword(glyph_rows[c];
end else
begin
i←1;
while i≤7 do
begin
oc_halfword(0);
incr(i);
end;
oc_halfword(-1);
incr(c);
end;
rel_ptr_base←char_seg_file_pos-2*nc;
c←bc;
while c≤ec do
begin
if glyph_ptr[c]≠-1 then oc_word(glyph_ptr[c]-rel_ptr_base)
else oc_word(-1);
incr(c);
end;
print_nl; print('oc byte no at preamble end= '); print(oc_byte_no:4);
@!glyph_ptr: array [0..max_glyph_no] of integer; {called charsegptr in MFDOVR}
@!glyph_cols: array [0..max_glyph_no] of integer; {BBdxArray in MFDOVR}
@!glyph_rows: array [0..max_glyph_no] of integer; {BBdyArray in MFDOVR}
@!min_x_array: array [0..max_glyph_no] of integer; {BBoxArray in MFDOVR}
@!min_y_array: array [0..max_glyph_no] of integer; {BBoyArray in MFDOVR}
@!cols_offset: array [0..max_glyph_no] of integer;
@!rows_offset: array [0..max_glyph_no] of integer;
procedure makeoc # outputs the current character to .oc file;
begin integer i,x,y,ch;
integer padbits, charbits, charwords;
integer coladdr, wdaddr, shft, bitptr, pfield, accum, ocfilepos;
ch←openofil(doveroc);
if not bndboxvalid then bndbox;
if charsegptr[charcode]≠-1 then error("Duplicate charcode: '"&cvos(charcode));
bbdx←max_x+1-min_x;
bbdy←max_y+1-min_y;
bbox←min_x;
bboy←min_y;
bbdx_array[char_code]←bbdx; bbdy_array[char_code]←bbdy;
bbox_array[char_code]←bbox; bboy_array[char_code]←bboy;
charwx←charwd;
charwy←0.0;
end;
CharWidthX[charcode]←charwx;
CharWidthY[charcode]←charwy;
charbits←bbdx*bbdy;
charwords←2*((charbits+31) div 32) # orbitchars block must be
and even number of sixteen-bit words;
padbits←16*charwords-charbits;
charsegptr[charcode]←bytecount[doveroc] div 2 # bytes to 16-bit words;
@ We will have to make some calculations in floating point and convert the
results to integers.
@p function phys_size(i:integer):integer;
var r: real;
begin
r←(i*magnification*2540/ppi)+0.5;
phys_size←round(r);
end;
@#
function pix_res(i:real):integer;
var r: real;
begin
r←(i*ppi*10/magnification)+0.5;
pix_res←round(r);
end;
@#
function new_width(i:real):integer;
var r: real;
begin
r←(i*resolution*(2↑16))+0.5;
new_width←round(r);
end;
saf real array CharWidthX[0:'177];
@#
procedure oc_string(s:string; maxbytes:integer);
var i,len: integer;
begin
if maxbytes<length(s) then len←maxbytes else len←lenght(s);
oc_byte(len);
for i←1 to maxbytes-1 do
if i<=len then oc_byte(s[i to i]) else oc_byte(0);
end;
@ Convert pixels to fixes, scaling out designsize. This is misplaced???
@<Subroutines...@>=
function amf_fix(i:integer):integer;
var r: real;
begin
r←i*(72.27/722.909)/(magnification*design_size/@"100000);
amf_fix←round(r*@"100000);
end;
oc_halfword((xresolution*ppi*10/magnification)+0.5);
oc_halfword((yresolution*ppi*10/magnification)+0.5);
phys_size←(design_size*magnification*2540/ppi)+0.5;
oc_halfword(phys_size(design_size)); {physical size in micas}
@#
function phys_size(i:integer):integer;
var r: real;
begin
r←i*magnification*2540/ppi)+0.5;
phys_size←round(r);
end;
@#
function pix_res(i:integer):integer;
var r: real;
begin
r←i*ppi*10/magnification)+0.5);
pix_res←round(r);
end;
MFDOVR.SAI calls for;
Wout(doveroc,IX(1,12)) # header for family-name IX;
Wout(doveroc,IX(5,11)) # header for orbit-chars IX;
where IX is defined as:
define IX(typ, lngth)=⊂((typ lsh 12)+lngth)⊃;
simple procedure rastpreamble; begin integer i, n; string s;
define devstr=⊂"ImPrint-10"⊃, shuv(a)="bout(rstfnt,a)";
s← fontidentifier; # font identifier string;
shuv(length(s)); while s≠"" do shuv(lop(s));
s← fontfacebyte # font face byte string;
shuv(length(s)); while s≠"" do shuv(lop(s));
,@ @procedure oc_string(s:string, maxbytes:integer);
var i,len: integer;
begin
len←(maxbytes-1) min length(s);
oc_byte(len);
for i←1 to maxbytes-1 do
if i<=len then ocxbyte(s[i to i]) else oc_byte(0);
end;
@<Constants...@>=
@! char_seg_file_pos=1536; {halfword where raster information is to start}
@d chardw==device_width
@ @<Glob...@>=
@!seg_start: integer;
@!seg_end: integer;
@!newxwidth: integer;
@!phys_size: integer;
@ When we get to this section we have all the essential information needed to
write the preamble information into the |oc_file|.
@<Write the |oc| initial information@>=
begin
bc←0; while (glyph_ptr[bc]=-1) and (bc<max_glyph_no) do incr(bc);
ec←max_glyph_no;
while (glyph_ptr[ec]=-1) and (ec>0) do decr(ec);
if bc>ec then begin error('No characters in this font!'); goto 9998; end;
nc←ec+1-bc;
seg_start←char_seg_file_pos-(8+2)*nc;
seg_end←char_seg_file_pos+(wd_byte_no div 2);
if (font_face_byte<0) or (font_face_byte>127) then error('Fontface out of bnds');
oc_halfword(0); {header for family-name IX}
oc_halfword(0); {name code}
oc_string(fontidentifier,20);
oc_halfword(0); {header for orbit-chars IX}
oc_byte(0); {name code again}
oc_byte(bc); {charcode for the first glyph}
oc_byte(ec); {charcode for the last glyph}
oc_byte(font_face_byte); {logical size encoded as font face byte}
phys_size←(design_size*magnification*2540/ppi)+0.5;
oc_halfword(phys_size); {physical size in micas}
oc_halfword(0.5); {rotation in minutes of arc}
oc_word(char_seg_file_pos); {starting file pos of font segment in halfwords}
oc_word(wd_byte_no div 2); {font segment length in half words}
oc_halfword((xresolution*ppi/magnification)+0.5);
oc_halfword((yresolution*ppi/magnification)+0.5);
oc_halfword(IX); {endIX}
if oc_byte_no≠48 then error('This cannot happen: header error');
while oc_byte_no<((2*seg_start)-24) do oc_halfword(0);
println; print('oc byte no = ',oc_byte_no:4); print(' at end of padding');
end
c← bc;
while c≤ec do
begin
if glyph_ptr[c]≠-1 then
begin
new_width←(CharWidthX[c]*xresolution*(2↑16))+0.5;
oc_word(new_width); {this should be ?}
oc_word(0); { I think CharWidthY this should be zero}
oc_halfword(BBoxArray[c]);
oc_halfword(BBoyArray[c]);
oc_halfword(BBdxArray[c]);
oc_halfeord(BBdyArray[c]);
end
else begin
for i←1 thru 7 do oc_halfword(0);
oc_halfword(-1) # marks a non-existent character;
end;
rel_ptr_base←char_seg_file_pos-2*nc;
if ec_byte_no≠rel_ptr_base*2 then error('This can''t happen: ec byte no is off');
c←bc
while c≤ec do
if glyph_ptr[c]≠-1 then oc_word(glyph_ptr[c]-rel_ptr_base)
else oc_word(-1);
end;
rel_ptr_base←char_seg_file_pos-2*nc;
if wd_byte_no≠relptrbase*2 then error('Something is wrong');
c←bc;
while c≤ec do
begin
if glyph_ptr[c]≠-1 then oc_word(glyph_ptr[c]-rel_ptr_base)
else oc_word(-1); {marking a non-existent char}
incr(c);
end;
end;
for c←bc thru ec do
if charsegptr[c]≠-1 then
begin
comment Convert the spacing Xwidth of the character
from points into (fixed.fraction) pixels;
integer newwidth;
newwidth←(CharWidthX[c]*xresolution*(2↑16))+0.5;
Dout(doveroc,newwidth);
newwidth←(CharWidthY[c]*yresolution*(2↑16))+0.5;
Dout(doveroc,newwidth);
Wout(doveroc,BBoxArray[c]);
Wout(doveroc,BBoyArray[c]);
Wout(doveroc,BBdxArray[c]);
Wout(doveroc,BBdyArray[c]);
end
else begin
integer i;
for i←1 thru 7 do Wout(doveroc,0);
Wout(doveroc,-1) # marks a non-existent character;
end;
relptrbase←charsegfilepos-2*nc;
DEBUGONLY if bytecount[doveroc]≠relptrbase*2 then confusion;
for c←bc thru ec do
if charsegptr[c]≠-1 then Dout(doveroc,charsegptr[c]-relptrbase)
else Dout(doveroc,-1); {marking a non-existent char}
end;
design_size←signed_quad; check_sum←signed_quad;@/
print('design size = ',design_size:1,' (');
print_scaled(design_size div 16); print_ln('pt)');
define charwd=⊂realparam[7]⊃ # width of character to be output;
define charht=⊂realparam[8]⊃ # height of character to be output;
define chardp=⊂realparam[9]⊃ # depth of character to be output;
device_width[c]←signed_quad; {chardw in pixels :integer]
tfm_width[c]←signed_quad;
@!glyph_ptr: array [0..max_glyph_no] of integer; {called charsegptr in MFDOVR}
@!glyph_cols: array [0..max_glyph_no] of integer; {BBdxArray in MFDOVR}
@!glyph_rows: array [0..max_glyph_no] of integer; {BBdyArray in MFDOVR}
@!min_x_array: array [0..max_glyph_no] of integer; {BBoxArray in MFDOVR}
@!min_y_array: array [0..max_glyph_no] of integer; {BBoyArray in MFDOVR}
@!cols_offset: array [0..max_glyph_no] of integer;
@!rows_offset: array [0..max_glyph_no] of integer;
comment special stuff for byte-oriented output;
comment Here are some procedures for doing byte-oriented output.
SAIL's normal "wordout" is doing the real work. The arrays
nextword holds the bytes that will go into making a new
output word as they accumulate. The array bytecount keeps
track of the total number of bytes output to each file;
*** FROM MFOUT.SAI ***
comment integer array nextword,bytecount[1:numberofmodes];
simp procedure Bout(integer mode, byte);
begin comment output an 8-bit byte to channel for mode;
integer cnt,nxtwd,ofst;
cnt←bytecount[mode];
case (cnt mod 4) of
begin
[0] nextword[mode]←byte lsh 28;
[1] nextword[mode]←
nextword[mode] lor ((byte land '377) lsh 20);
[2] nextword[mode]←
nextword[mode] lor ((byte land '377) lsh 12);
[3] wordout(ochan[mode],
nextword[mode] lor ((byte land '377) lsh 4));
else confusion
end;
bytecount[mode]←cnt+1;
end;
simp procedure Wout(integer mode,word);
begin comment output a 16-bit word to channel for mode;
integer cnt,nxtwd,ofst;
cnt←bytecount[mode];
case (cnt mod 4) of
begin
[0] nextword[mode]←word lsh 20;
[2] wordout(ochan[mode],
nextword[mode] lor ((word land '177777) lsh 4));
else confusion comment must be at 16-bit-word boundary;
end;
bytecount[mode]←cnt+2;
end;
simp procedure Dout(integer mode,word);
begin
Wout(mode,word lsh -16); Wout(mode, word);
end;
simp procedure DoutAligned(integer mode,word);
begin
integer cnt;
cnt←bytecount[mode];
if (cnt mod 4)≠0 then confusion;
wordout(ochan[mode],word);
bytecount[mode]←cnt+4;
end;
simp procedure Sout(integer mode, ptr, numbytes);
begin comment output a string of 8-bit bytes: the output file
must start out 32-bit-word aligned!;
integer i, numwords, rembytes;
if bytecount[mode] mod 4≠0 then confusion;
numwords←numbytes div 4;
rembytes←numbytes mod 4;
arryout(ochan[mode],memory[ptr],numwords);
nextword[mode]←memory[ptr+numwords] land (-1 lsh (bitsperwd-8*rembytes));
bytecount[mode]←bytecount[mode]+numbytes;
end;
simp procedure BCPLout(integer mode; string s; integer maxbytes);
begin
integer len, i;
len←(maxbytes-1) min length(s);
Bout(mode,len);
for i←1 thru maxbytes-1 do
if i<=len then Bout(mode,s[i to i]) else Bout(mode,0);
end;
simp procedure DVISout(integer mode; string s);
begin
integer len, i;
len←length(s);
Bout(mode,len);
for i←1 thru len do Bout(mode,s[i to i]);
end;
IFDOVERMODES
define nonexistentcharflag=⊂-(2.0↑120)⊃ # a real number that won't occur
as the vector width X component of any real character;
saf real array CharWidthX[0:'177];
saf real array CharWidthY[0:'177] # x and y components of
the vector widths of characters;
integer bbxlmin, bbxrmax, bbylmin, bbyhmax # extremes of bounding box;
real charwxmax, charwxmin, charwymax, charwymin # extremes of width vector
components;
define IX(typ, lngth)=⊂((typ lsh 12)+lngth)⊃;
saf integer array charsegptr[0:'177] # filepos's of individual char segments;
define charsegfilepos=⊂('3000)⊃ # earliest filepos in .oc file that a
character segment can start (in 16-bit words), rounded up to the
nearest multiple of 2*pagesize(For WAITS' sake!);
ENDDOVERMODES
@An essential part of the work in going from |gf| to |oc| involvs
the shift in scanning direction. This can be done by brute force by generating
a big array of pixels to hold the character image as suggested in \.{GFTYPE}
or it can be done by finesse following the suggestion made by John Hobby.
@↑Hobby, John Douglas@>
Having tried the brute force method and having found it to be quite wasteful
of computer time (and memory space) we have elected to go the other way.
Our task is somewhat easier than that faced in \.{MF.WEB} itself as we
need to contend with but two pixel weights. and our original data has
already been segmented into |paint| commands that mark the vertical edges.
Our task is to locate the horizontal edges between columns by comparing
adjacent pairs of rows and storing the results in linked lists, one list
for each x value in the range from |min_x| to |max_x|. We get these
records in the desired order by inserting each
new edge record between the header of the appropiate list and the immediately
following record. We can then expand each linked list and write
the output data in the prescribed order from bottom up.
@<Constants...@>=
@!max_glyph_no=255; {maximum glyph number in font}
@!max_y_allowed=400;
@!min_y_allowed=-150;
@!max_x_allowed=400;
@!min_x_allowed=-50;
@!max_p_c=50; {a reasonable figure for the maximum number to vertical edges}
@d p_array==paint_array[y,p_c]
@<Glob...@>=
@!paint_array:array[min_y_allowed..max_y_allowed,0..max_p_c] of integers;
@!p_c: integer; {used as second coordinate in |paint_array|}
@!flag: integer; {used to mark exhaustion of |paint_array| data}
@ @<Clear the paint array@>=
y←min_y_allowed;
while y≤max_y_allowed do
begin
p_c←0;
while p_c≤max_p_c do
begin
p_array←0;
incr(p_c);
end
incr(y);
end;
@ The bulk of a \.{GF} file generally consists of |paint| commands,
so we collect them together and store the extracted information in
the appropiate locations in the |paint_array|.
@<Translate a sequence of |paint| commands...@>=
begin
repeat @<Store it away@>;
start_op;
until o>paint1+3;
end
@ @<Store it away@>=
incr(p_c); p_array←p;
if p>0 then
begin if y>max_y_observed then max_y_observed←y;
if y<min_y_observed then min_y_observed←y;
l←x; r←x+p-1;
if r>max_x_observed then max_x_observed←r;
if l<min_x_observed then min_x_observed←l;
x←r+1;
end;
paint_switch←white+black-paint_switch
{could also be |paint_switch←not paint_switch|}
@ @<Translate a |new_row|, |right| or |left| command@>=
begin show_mnemonic('newrow ',p:1);
decr(y); z←z+p; x←z; paint_switch←black;
p_c←0;
if z>0 then
begin
p_array←white;
incr(p_c); p_array←z;
end else p_array←black;
end;
@ @<Translate a |skip| command@>=
begin
p_c←0;
while p>0 do
begin
decr(y);
p_array←white;
incr(p_c); p_array←-1; decr(p_c);
end;
decr(y);
if z>0 then
begin
p_array←white;
incr(p_c); p_array←z;
end else p_array←black;
end
show_mnemonic('skip',o-skip1+1:1,' ',p:1);
y←y-(p+1); x←z; paint_switch←black;
if wants_mnemonics then print(' (y=',y:1,', z=',z:1,')');
end
@ @<Remove blank rows at left@>=
if min_x_observed>0 then
begin
a←min_x_observed;
y←min_y; p_c←1;
while y<=max_y do
begin
p_array←p_array-a;
if p_array=0 then
begin
paint_array[y,0]←black;
p_array←paint_array[y,2];
p_c←2;
while p_array≠0 do
begin
p_array←paint_array[y,p_c+1];
incr(p_c);
end;
p_c←1;
end;
incr(y);
end;
end;
@ @<Write the |oc| raster@>=
y←min_y; p_c←0;
flag←max_y+1-min_y; {to be reduced by 1 each tine a row is exhausted}
while flag>0 do
begin
if y<(max_y-7) then @<Get full byte@>
else @<Get mixed byte@>;
oc_byte(b);
end;
if (oc_byte_no mod 2) ≠0 then oc_byte(0);
@ @<Get full byte@>=
begin
b←p_array; incr(y)
for i←2 to 8 do
begin
b←b*2+p_array; incr(y); incr(i);
end;
if y>max_y then update_array;
end
@ @<Get mixed byte@>=
begin
b←p_array; incr(y);
while y≤max_y do
begin
b←b*2+p_array; incr(y); incr(i);
end;
update_array;
if flag>0 then
begin
for i←i to 8 do
begin
b←b*2+p_array; incr(y);
end;
end
else
for i←i to 8 do b←b*2;
end
@p procedure update_array;
begin
y←min_y; p_c←1;
while y≤max_y do
begin
if p_array>0 then
begin
decr(p_array);
if p_array=0 then @<Effect |paint_switch| change@>;
end;
incr(y);
end;
y←min_y; p_c←0;
end;
@ @<Effect |paint_switch| change@>=
begin
if paint_array[y,p_c+1]=0 then
begin
decr(flag); paint_array[y,0]←white;
end
else
begin
paint_array[y,0]←black+white-paint_array[y,0];
p_array←paint_array[y,2];
p_c←2;
while p_array≠0 do
begin
p_array←paint_array[y,p_c+1];
incr(p_c);
end;
p_c←1;
end;
end
@ @<Glob...@>=
@!glyph_ptr: array [0..max_glyph_no] of integer;
@!glyph_cols: array [0..max_glyph_no] of integer;
@!glyph_rows: array [0..max_glyph_no] of integer;
@!cols_offset: array [0..max_glyph_no] of integer;
@!rows_offset: array [0..max_glyph_no] of integer;
@!bc,ec:integer;
@!oc_dir_ptr:integer;
@!oc_mag: integer;
If the name of a file ends with th extension .OC, that file by convention,
should contain a single segment of type OrbitChars.
Data segments of type OrbitChars have an internal structure that is a
minature version of the structure of the complete dictionary file. At the
beginning of these segements, there is a table of header information that
specifies the dimensions and widths of each character in the font.next
there is a table of file pointers that give, for each character code, the
location of the corresponding raster block. And finally, there are the
raster blocks themselves. Most font software always writes the individual
raster blocks in character code order, and without leaving any gaps; that
is the font segment is compact at the character level.
Bask char 97: 3≤x<44 -1≤y<44
43 w 13 11
42 w 10 17
41 w 8 7 7 7
40 w 7 11 7
39 w 6 6 13 7
38 w 6 5 14 8
37 w 5 6 15 8
36 w 5 6 15 8
35 w 5 6 15 8
34 w 5 6 15 9
33 w 5 6 15 9
32 w 6 4 16 9
31 w 26 9
30 w 26 9
29 w 26 9
28 w 26 9
27 w 26 9
26 w 26 9
25 w 24 11
24 w 22 13
23 w 19 6 1 9
22 w 17 5 4 9
21 w 15 5 6 9
20 w 13 6 7 9
19 w 11 6 10 8
18 w 10 6 11 8
17 w 8 7 12 8
16 w 7 7 13 8
15 w 6 7 14 8
14 w 5 8 14 8
13 w 5 8 14 8
12 w 4 8 15 8
11 w 4 8 15 8
10 w 3 9 15 8
9 w 3 9 15 8
8 w 3 9 15 8
7 w 3 9 14 9
6 w 3 10 12 10 7 2
5 w 4 9 10 12 7 1
4 w 4 11 6 5 2 8 5 2
3 w 5 19 4 15
2 w 6 17 6 13
1 w 7 14 9 11
0 w 9 10 13 7
-1 w 11 6